perm filename VIEWER[GEM,BGB]2 blob sn#036853 filedate 1973-04-25 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00024 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00005 00002	TITLE VIEWER  -  IMAGE FORMING SUBROUTINES  -  JULY 1972.
 00006 00003	SUBR(SHOW1)WINDOW,GLASS -----------------------------------------
 00008 00004	SUBR(SHOW2)WINDOW,GLASS ------------------------------------------
 00010 00005	SUBR(CROP)WINDOW -------------------------------------------------
 00012 00006	SUBR(PPROJ)CAMERA,WORLD---------------------------------------
 00014 00007	TRANSLATE TO CAMERA LOCUS.
 00015 00008	PPROJ(CAMERA,WORLD) CONTINUED.
 00017 00009	SUBR(EMRKALL)WORLD-----------------------------------------------
 00018 00010	SUBR(UNPROJECT)VERTEX---------------------------------------------
 00020 00011	SUBR(FACOEF)BODY OR FACE,FLAG-------------------------------------
 00023 00012	SUBR(ENORM)BODY---------------------------------------------------
 00025 00013	SUBR(ZCLIPF)FACE--------------------------------------------------
 00027 00014	SUBR(FMRK)WORLD--------------------------------------------------
 00029 00015	SUBR(EMRK)WORLD--------------------------------------------------
 00032 00016	VMARK(WINDOW,WORLD) - MARK THE NSEW BIT OF ALL THE VERTICES.
 00034 00017	SUBR(ZCLIP)V1,U,V2------------------------------------------------
 00036 00018	XY-CLIPPER, SKIPS WHEN PORTION IS VISIBLE.
 00038 00019	XY-CLIPPER continued.
 00040 00020	SUBR(CLIPER)WINDOW -----------------------------------------------
 00042 00021	MAKE CURVY EDGED OBJECTS.
 00044 00022	CROSS I-VECTOR INTO J-VECTOR TO GET K-VECTOR RIGHT-HANDED.
 00046 00023	CREATE A VERTEX ON THE CUBIC EDGE.
 00048 00024	END
 00049 ENDMK
⊗;
TITLE VIEWER  -  IMAGE FORMING SUBROUTINES  -  JULY 1972.

	EXTERN OTHER,VCW,VCCW,ECCW
	EXTERN KLJUTS,KLJOTS,KLTMPS
	EXTERN IIIDPY

;VARIABLES GLOBAL TO VIEWER SUBROUTINES.
	DECLARE{XL,XH,YL,YH}
	DECLARE{FOCAL,LDZ}
	DECLARE{SCALEX,SCALEY,SCALEZ}
	DECLARE{SOX,SOY,MAG}
	DECLARE{CAMFRAME}

	DECLARE{ZCCMIN}
	DECLARE{FOLDCNT,EDGECNT}

	DECLARE{CAMERA,WINDOW,WORLD,GLASS}
SUBR(SHOW1)WINDOW,GLASS -----------------------------------------
BEGIN SHOW1; SHOW THRU WINDOW, TYPE 1 - DISPLAY ALL EDGES IN VIEW.
	LACM ARG1↔ANDI 17↔DAC GLASS
	LAC 1,ARG2↔DAC 1,WINDOW
	ALT2 2,1↔DAC 2,WORLD↔JUMPE 2,POP2J.
	$TYPE 0,2↔CAIE 0,$WORLD↔GO .+4
	ALT 0,1↔DAC CAMERA↔JUMPE POP2J.
	CALL(PPROJ,CAMERA,WORLD)
	CALL(EMRKALL,WORLD)
	CALL(CLIPER,WINDOW)
	CALL(IIIDPY,WINDOW,GLASS)
	POP2J
BEND SHOW1; BGB 16 MARCH 1973 ------------------------------------

SUBR(SHOW3)WINDOW,GLASS -----------------------------------------
BEGIN SHOW3; SHOW THUR WINDOW, TYPE 3 - BACKSIDED FACES REMOVED.
	LACM ARG1↔ANDI 17↔DAC GLASS
	LAC 1,ARG2↔DAC 1,WINDOW
	ALT 0,1↔DAC CAMERA↔JUMPE POP2J.
	ALT2 0,1↔DAC WORLD↔JUMPE POP2J.
	CALL(PPROJ,CAMERA,WORLD)
	CALL(FMRK,WORLD)
	CALL(EMRK,WORLD)
	CALL(CLIPER,WINDOW)
	CALL(IIIDPY,WINDOW,GLASS)
	POP2J
BEND SHOW3; BGB 16 MARCH 1973 ------------------------------------

SUBR(SHOW2)WINDOW,GLASS ------------------------------------------
BEGIN SHOW2; SHOW WINDOW TYPE 2 - VECTOR HIDDEN LINE IMAGE.
	EXTERN OCCULT
	LACM ARG1↔ANDI 17↔DAC GLASS
	LAC 1,ARG2↔DAC 1,WINDOW
	ALT 0,1↔DAC CAMERA↔JUMPE POP2J.
	ALT2 0,1↔DAC WORLD↔JUMPE POP2J.
	CALL(PPROJ,CAMERA,WORLD)
	CALL(FMRK,WORLD)
	CALL(EMRK,WORLD)
	CALL(OCCULT,WORLD)
	CALL(KLJOTS,WORLD)
	CALL(CLIPER,WINDOW)
	CALL(IIIDPY,WINDOW,GLASS)
	CALL(KLTMPS,WORLD)
	POP2J
BEND SHOW2; 16 MARCH 1973 ----------------------------------------

SUBR(SHOW4)WINDOW,GLASS ------------------------------------------
BEGIN SHOW3; SHOW WINDOW TYPE 3B - RUN OCCULT DIAGONOSTICS.
	EXTERN OCCULT
	LACM ARG1↔ANDI 17↔DAC GLASS
	LAC 1,ARG2↔DAC 1,WINDOW
	ALT 0,1↔DAC CAMERA↔JUMPE POP2J.
	ALT2 0,1↔DAC WORLD↔JUMPE POP2J.
	CALL(PPROJ,CAMERA,WORLD)
	CALL(FMRK,WORLD)
	CALL(EMRK,WORLD)
	CALL({OCCULT+1},WORLD)
	CALL(KLJOTS,WORLD)
	CALL(CLIPER,WINDOW)
	CALL(IIIDPY,WINDOW,GLASS)
	CALL(KLTMPS,WORLD)
	POP2J
BEND;2/12/73------------------------------------------------------
SUBR(CROP)WINDOW -------------------------------------------------
BEGIN CROP
; XL ← (OX - MAG*LDX) MAX -511.
; XH ← (OX + MAG*LDX) MIN +511.
; YL ← (OY - MAG*LDY) MAX -384.
; YH ← (OY + MAG*LDY) MIN +384.
	ACCUMULATORS{WND,C,OX,OY,LDX,LDY,MAG}
	LAC WND,ARG1
	ALT C,WND↔JUMPE C,POP1J.
	LAC MAG,-1(WND)
	NIP OX,-2(WND)↔FLOAT OX,
	NAP OY,-2(WND)↔FLOAT OY,
	NAP LDX,1(C)↔FLOAT LDX,
	NAP LDY,2(C)↔FLOAT LDY,

	LAC LDX↔FMPR MAG↔DAC OX,1
	FSBR 1,0↔FADR 0,OX↔FIXX 0,↔FIXX 1,
	CAMGE 1,[-=511]↔LAC 1,[-=511]↔DIP 1,1(WND)
	CAMLE 0,[ =511]↔LAC 0,[ =511]↔DAP 0,1(WND)

	LAC LDY↔FMPR MAG↔DAC OY,1
	FSBR 1,0↔FADR 0,OY↔FIXX 0,↔FIXX 1,
	CAMGE 1,[-=384]↔LAC 1,[-=384]↔DIP 1,2(WND)
	CAMLE 0,[ =384]↔LAC 0,[ =384]↔DAP 0,2(WND)

	POP1J
BEND CROP; 13 MARCH 1973 -----------------------------------------
SUBR(PPROJ)CAMERA,WORLD---------------------------------------
BEGIN PPROJ
	ACCUMULATORS{B,F,E,V,CAM,E0,X,XX,Y,YY,Z,ZZ}
	LAC B,ARG1↔$TYPE 0,B↔CAIE $WORLD↔POP2J
;CLEAR FACE PZZ & NZZ BITS.
	LAC B,ARG1
I0:	CCW B,B↔TESTZ B,BBIT↔GO[LAC F,B
I1:	PFACE F,F↔TEST F,FBIT↔GO I0↔MARKZ F,PZZ∨NZZ↔GO I1]

;GET CAMERA SCALES AND FOCAL.
	LAC CAM,ARG2
	LAC -3(CAM)↔DAC SCALEX
	LAC -2(CAM)↔DAC SCALEY
	LAC -1(CAM)↔DAC SCALEZ
	HLLZ 3(CAM)↔DAC FOCAL
	CDR 3(CAM)↔FLOAT↔DAC LDZ

;GET THE CAMERA'S FRAME.
	LAC CAM,ARG2
	FRAME CAM,CAM
	DAC CAM,CAMFRAME

;FOR ALL THE BODIES OF THE WORLD.
	LAC B,ARG1
L1:	CCW B,B
	TEST B,BBIT↔POP2J
	MARKZ B,VISIBLE

;FOR ALL THE VERTICES OF EACH BODY.
	LAC V,B
L2:	PVT V,V
	TEST V,VBIT↔GO L1
	ZIP 7(V); CLEAR POTENT VALENCE.
;TRANSLATE TO CAMERA LOCUS.

	LAC X,XWC(V)↔FSBR X,XWC(CAM)
	LAC Y,YWC(V)↔FSBR Y,YWC(CAM)
	LAC Z,ZWC(V)↔FSBR Z,ZWC(CAM)

;ROTATE TO CAMERA ORIENTATION.

	DEFINE ROTATE $(QQ,Q){
	LAC QQ,X↔ FMPR QQ,Q$X(CAM)
	LAC Y↔FMPR Q$Y(CAM)↔FADR QQ,
	LAC Z↔FMPR Q$Z(CAM)↔FADR QQ,}
	ROTATE(XX,I);
	ROTATE(YY,J);
	ROTATE(ZZ,K);

;PERSPECTIVE TRANSFORMATION.

	FMPR XX,SCALEX↔FDVR XX,ZZ↔DAC XX,XPP(V)
	FMPR YY,SCALEY↔FDVR YY,ZZ↔DAC YY,YPP(V)
	MOVN Z,SCALEZ↔FDVR Z,ZZ↔DAC Z,ZPP(V)
;PPROJ(CAMERA,WORLD) CONTINUED.
;DO Z-CLIP MARKING WRT CAMERA CENTERED COORDINATES.
	LAC X,[JUTBIT+JOTBIT+PZZ+NZZ+FOLDED+VISIBLE+POTENT+1B18];1B18 IS TBIT1
	ANDCAM X,(V)		;TURN 'EM ALL OFF.
	SLACI X,(PZZ)		; + HALFSPACE, BEHIND THE CAMERA.
	MOVN FOCAL
	CAMGE ZZ,0		;SKIP WHEN Zcc ≥ -FOCAL.
	SLACI X,(NZZ)		; - HALFSPACE, INVIEW.
	IORM X,(V)
	PED E,V↔DAC E,E0↔JUMPE E,[
		PFACE F,B↔IORM X,(F)↔GO L1] ;VERTEX BODY CASE.

L3:	PVT 1,E↔CAME 1,V↔GO .+3↔PCW 1,E↔GO .+5
	NVT 1,E↔CAME 1,V↔GO L2 ↔NCW 1,E
	IORM X,(E)
	PFACE F,E↔IORM X,(F)
	NFACE F,E↔IORM X,(F)
	LAC E,1↔CAME E,E0↔GO L3↔GO L2
BEND;1/14/73------------------------------------------------------
SUBR(EMRKALL)WORLD-----------------------------------------------
BEGIN EMRKALL;MARK ALL EDGE AS POTENT.
	ACCUMULATORS{B,E}
;FOR ALL THE BODIES OF THE WORLD.
	LAC B,ARG1
L1:	CCW B,B
	TEST B,BBIT↔POP1J
;FOR ALL THE EDGES OF EACH BODY.
	LAC E,B
L2:	PED E,E
	TEST E,EBIT↔GO L1
	MARK E,POTENT↔GO L2
BEND;1/14/73------------------------------------------------------
SUBR(UNPROJECT)VERTEX---------------------------------------------
BEGIN UNPROJ
	ACCUMULATORS{V,C,X,Y,Z,XX,YY,ZZ}
	LAC V,ARG1
	LAC C,CAMFRAME

;UNDO PERSPECTIVE.
	LACN Z,SCALEZ↔FDVR Z,ZPP(V)
	LAC  Y,YPP(V)↔FMPR Y,Z↔FDVR Y,SCALEY
	LAC  X,XPP(V)↔FMPR X,Z↔FDVR X,SCALEX

;ROTATE BY TRANSPOSE OF CAMERA ORIENTATION.
	LAC XX,X↔FMPR XX,IX(C)
	LAC Y↔FMPR JX(C)↔FADR XX,
	LAC Z↔FMPR KX(C)↔FADR XX,

	LAC YY,Y↔FMPR YY,IY(C)
	LAC Y↔FMPR JY(C)↔FADR YY,
	LAC Z↔FMPR KY(C)↔FADR YY,

	LAC ZZ,Z↔FMPR ZZ,IZ(C)
	LAC Y↔FMPR JZ(C)↔FADR ZZ,
	LAC Z↔FMPR KZ(C)↔FADR ZZ,

;TRANSLATE TO CAMERA LOCUS.
	FADR XX,XWC(C)↔DAC XX,XWC(V)
	FADR YY,YWC(C)↔DAC YY,YWC(V)
	FADR ZZ,ZWC(C)↔DAC ZZ,ZWC(V)
	POP1J
BEND;1/14/73------------------------------------------------------
SUBR(FACOEF)BODY OR FACE,FLAG-------------------------------------
BEGIN	FACOEF;FACE COEFFICIENTS - FLAG=0 FOR WC, FLAG=-1 FOR PP.

	ACCUMULATORS {Q,E,V1,V2,V3,ABC,F,ARG}
	FOR @% Qε{XYZ}{FOR @$ N←1,3{
	DEFINE Q%$N<Q%WC(V$N)>↔}}
;FOREACH F|BF⊗B≡F.
	LAC F,ARG2
	LAC ARG,(F) ;ORIGINAL ARG TYPE.
	TLNN ARG,(BBIT)↔GO L2
L1:	PFACE F,F
	TEST F,FBIT↔POP2J
;FIRST THREE VERTICES CCW ABOUT THE FACE.
L2:	PED E,F↔ZIP 6(F)	;CLEAR ALT LINK.
	SETQ(V1,{VCW,E,F})
	SETQ(V2,{VCCW,E,F})
	SETQ(E,{ECCW,E,F})
	SETQ(V3,{VCCW,E,F})
;FLG TRUE FOR PERSPECTIVE PROJECTED FACOEF.
	SKIPE ARG1
	GO[ADDI V1,7↔ADDI V2,7↔ADDI V3,7↔GO .+1]
;KK(F) ← X1*(Z2*Y3-Y2*Z3) + Y1*(X2*Z3-Z2*X3) + Z1*(Y2*X3-X2*Y3).
	LAC 1,Z2↔FMPR 1,Y3↔LAC Y2↔FMPR Z3↔FSBR 1,0↔FMPR 1,X1
	LAC 2,X2↔FMPR 2,Z3
	LAC Z2↔FMPR X3↔FSBR 2,0↔FMPR 2,Y1↔FADR 1,2
	LAC 3,Y2↔FMPR 3,X3
	LAC X2↔FMPR Y3↔FSBR 3,0↔FMPR 3,Z1↔FADR 1,3
	DAC 1,KK(F)
;AA(F) ← (Z1*(Y2-Y3) + Z2*(Y3-Y1) + Z3*(Y1-Y2)).
	LAC 1,Y2↔FSBR 1,Y3↔FMPR 1,Z1↔LAC 0,1
	LAC 1,Y3↔FSBR 1,Y1↔FMPR 1,Z2↔FADR 0,1
	LAC 1,Y1↔FSBR 1,Y2↔FMPR 1,Z3↔FADR 0,1
	DAC AA(F)↔FMPR↔DAC ABC
;BB(F) ← (X1*(Z2-Z3) + X2*(Z3-Z1) + X3*(Z1-Z2)).
	LAC 1,Z2↔FSBR 1,Z3↔FMPR 1,X1↔LAC 0,1
	LAC 1,Z3↔FSBR 1,Z1↔FMPR 1,X2↔FADR 0,1
	LAC 1,Z1↔FSBR 1,Z2↔FMPR 1,X3↔FADR 0,1
	DAC BB(F)↔FMPR↔FADRM ABC
;CC(F) ← (X1*(Y3-Y2) + X2*(Y1-Y3) + X3*(Y2-Y1)).
	LAC 1,Y3↔FSBR 1,Y2↔FMPR 1,X1↔LAC 0,1
	LAC 1,Y1↔FSBR 1,Y3↔FMPR 1,X2↔FADR 0,1
	LAC 1,Y2↔FSBR 1,Y1↔FMPR 1,X3↔FADR 0,1
	DAC CC(F)↔FMPR↔FADRM ABC
;NORMALIZE.
	EXTERN SQRT↔CALL(SQRT,ABC)↔SLACI(<1.0>)↔FDVR 1
	FMPRM AA(F)↔FMPRM BB(F)↔FMPRM CC(F)↔FMPRM KK(F)
	TLNN ARG,(BBIT)↔POP2J↔GO L1
BEND;1/14/73------------------------------------------------------
SUBR(ENORM)BODY---------------------------------------------------
BEGIN ENORM;COMPUTE EDGE NORMALS FROM FACE NORMALS.
	ACCUMULATORS{E,F1,F2}
	LAC E,ARG1
	PED E,E↔TEST E,EBIT↔POP1J
	PFACE F1,E↔NFACE F2,E
	LAC AA(F1)↔FAD AA(F2)↔FSC -1↔DACN AA(E)
	LAC BB(F1)↔FAD BB(F2)↔FSC -1↔DACN BB(E)
	LAC CC(F1)↔FAD CC(F2)↔FSC -1↔DACN CC(E)
	GO ENORM+1
BEND;1/14/73------------------------------------------------------

SUBR(VNORM)BODY---------------------------------------------------
BEGIN VNORM;COMPUTE VERTEX NORMALS FROM EDGE NROMALS.
	ACCUMULATORS{V,E,E0,A,B,C}
	LAC V,ARG1
L1:	PVT V,V↔TEST V,VBIT↔POP1J
	PED E,V↔SKIPN E0,E↔POP1J   ;VERTEX BODY CASE.
	SETZB 0,A↔SETZB B,C
L2:	FAD A,AA(E)↔FAD B,BB(E)↔FAD C,CC(E)
	PVT 1,E↔CAME 1,V↔GO .+3↔PCW E,E↔GO .+5
	NVT 1,E↔CAME 1,V↔AOJA .+5↔NCW E,E
	CAME E,E0↔AOJA L2↔AOS
	FSC 233↔FDV A,↔FDV B,↔FDV C,
	DAC A,XPP(V)↔DAC B,YPP(V)↔DAC C,ZPP(V)
	GO L1
BEND;1/14/73------------------------------------------------------
SUBR(ZCLIPF)FACE--------------------------------------------------
BEGIN ZCLIPF
	GO L0
	DECLARE{F,E,V,V1,V2,U0,U1,U2,ENEW,F0}
	EXTERN MKFE,ESPLIT
;GET A PZZ VERTEX OF F0
L0:	LAC 1,ARG1
	DAC 1,F0↔DAC 1,U1↔DAC 1,F
	PED 0,1↔DAC E

L1:	SETQ(E,{ECCW,E,F})
	SETQ(V,{VCCW,E,F})
	TEST 1,PZZ↔GO L1

;GET FIRST NZZ VERTEX CCW AROUND F FROM E.
L2:	SETQ(E,{ECCW,E,F})
	SETQ(V,{VCCW,E,F})
	TEST 1,NZZ↔GO L2

;MAKE Z-CLIP VERTEX.
	LAC 1,E↔PVT 0,1↔CAMN 0,V↔GO .+3↔CALL INVERT,E
	PVT 0,1↔DAC V1
	NVT 0,1↔DAC V2
	SETQ(U2,{ESPLIT,E})
	LAC 1,U2↔MARK 1,TMPBIT
	LAC 1,E↔TEST 1,DARKEN↔GO[
	LAC 1,U2↔MARK 1,DARKEN↔GO .+1]
	CALL ZCLIP,V1,U2,V2
	CALL UNPROJECT,U2
	LAC 1,U2↔MARK 1,NZZ

;MAKE Z-CLIP EDGE.
L3:	LAC 1,U1↔TEST 1,VBIT↔GO L4
	SETQ(ENEW,{MKFE,U1,F,U2})
	LAC 2,ENEW↔NFACE 1,2
	MARK  1,PZZ
	MARK 2,TMPBIT
	LAC 1,F↔MARKZ 1,PZZ
	MARK  1,NZZ
	CAMN  1,F0↔POP1J;  .......EXIT.
	NFACE 1,2↔DAC 1,F
	MARK  1,PZZ
	GO .+3
L4:	LAC U2↔DAC U0

;ADVANCE INTO THE NEXT FACE.
	LAC U2↔DAC U1
	SETQ(F,{OTHER,E,F})
	CAME 1,F0↔GO L2
	LAC U0↔DAC U2↔GO L3
BEND;1/14/73------------------------------------------------------
SUBR(FMRK)WORLD--------------------------------------------------
BEGIN FMRK; MARK POTENT FACES.
	ACCUMULATORS{W,B,F,Q,R}

;INITIALIZE THE WORLD'S POTENTIALLY VISIBLE FACE AND EDGE LISTS.
	LAC 1,ARG1↔SETZ
	PFACE. 0,1↔PED. 0,1↔NED. 0,1

;FOR ALL THE BODIES OF THE WORLD.
	LAC B,ARG1↔DAC B,BODY#
L1:	LAC B,BODY↔CCW B,B↔DAC B,BODY
	TEST B,BBIT↔POP1J

;FOR ALL THE FACES OF EACH BODY.
	LAC F,B
L2:	PFACE F,F↔DAC F,FACE#
	TEST F,FBIT↔GO L1
	HIDE F
	TEST F,NZZ↔GO L2	;FACE IS FULLY BEHIND THE CAMERA.
	TEST F,PZZ↔GO L3	;FACE IS PARTIALLY IN VIEW.
	CALL ZCLIPF,F		;DO Z-CLIPPING.
	LAC F,FACE
L3:	SETOM↔CALL(FACOEF,F,0)
	LAC F,FACE
	LAC CC(F)↔FMPR LDZ
	CAML KK(F)↔GO L2	;FACE HAS BACKSIDE TOWARDS CAMERA.

;POTENTIALLY VISIBLE FACE.
L4:	MARK F,POTENT
	LAC 1,ARG1↔PFACE 0,1
	POTEN. 0,F↔PFACE. F,1
	GO L2
BEND;1/14/73------------------------------------------------------
SUBR(EMRK)WORLD--------------------------------------------------
BEGIN EMRK; MARK POTENT EDGES FOR OCCULT.
	ACCUMULATORS{Q,R,S,B,F1,F2,E,A,FLG}
	ACCUMULATORS{V1,V2}
	EXTERN INVERT,SQRT
	SETZM FOLDCNT↔SETZM EDGECNT
;FOR ALL THE BODIES OF THE WORLD.
	LAC B,ARG1
L1:	CCW B,B↔TEST B,BBIT↔POP1J
;FOR ALL THE EDGES OF EACH BODY.
	LAC E,B
L2:	PED E,E↔TEST E,EBIT↔GO L1
	DZM↔POTEN. 0,(E)
	MARKZ E,7B13
	PFACE F1,E
	NFACE F2,E

;WHEN EITHER FACE IS POTENT THEN THE EDGE IS POTENT.
	LAC(F1)↔IOR(F2)↔TLNN(POTENT)↔GO L2
	MARK E,POTENT
;CONS THE EGDE INTO THE WORLD'S POTENTIALLY VISIBLE EDGE LIST.
	LAC 1,ARG1↔PED 0,1↔SKIPN↔NED. E,1
	PED. E,1↔POTEN. 0,E↔ZIP 7(E)
	AOSA FLG,EDGECNT

;COMPUTE NORMALIZED EDGE COEFFICIENTS.
SUBR(ECOEF)
	GO[SETZ FLG,↔LAC E,ARG1↔GO .+1]
	NVT V1,E↔PVT V2,E
	LAC YPP(V2)↔FSBR YPP(V1)↔DAC AA(E)↔FMPR↔DAC 1
	LAC XPP(V1)↔FSBR XPP(V2)↔DAC BB(E)↔FMPR↔FADR 1,0
	LAC XPP(V2)↔FMPR YPP(V1)
	LAC S,XPP(V1)↔FMPR S,YPP(V2)
	FSBR S↔DAC CC(E)
	CALL(SQRT,1)
	SLACI(<1.0>)↔FDVR 0,1
	FMPRM AA(E)↔FMPRM BB(E)↔FMPRM CC(E)
	JUMPE FLG,POP1J.
	MARK V1,POTENT↔IORM(V2)
	CAR 7(V1)↔AOS↔DIP 7(V1)	;VALENCE.
	CAR 7(V2)↔AOS↔DIP 7(V2)	;VALENCE.

;WHEN ONLY ONE FACE IS POTENT THEN EDGE IS FOLDED.
	LAC(F1)↔XOR(F2)↔TLNN(POTENT)↔GO L2
	TEST F1,POTENT↔GO[CALL INVERT,E↔GO .+1];NOTA BENE !
	MARK E,FOLDED↔IORM(V1)↔IORM(V2)
	GO L2
BEND;1/14/73------------------------------------------------------
;VMARK(WINDOW,WORLD) - MARK THE NSEW BIT OF ALL THE VERTICES.
VMARK:	0
BEGIN VMARK;BGB - 4 FEB 1973.
	ACCUMULATORS{B,E,V,X,Y}

;GET THE 2D CLIP WINDOW FRAME.
	LAC 1,ARG1
	NIP 1(1)↔FLOAT↔DAC XL
	NAP 1(1)↔FLOAT↔DAC XH
	NIP 2(1)↔FLOAT↔DAC YL
	NAP 2(1)↔FLOAT↔DAC YH

;SOURCE-OBJECT MAPPING.
	LAC -1(1)↔DAC MAG
	NIP 2,-3(1)↔FLOAT 2,↔FMPR 2,MAG
	NIP 0,-2(1)↔FLOAT↔FSB 2↔DAC SOX
	NAP 2,-3(1)↔FLOAT 2,↔FMPR 2,MAG
	NAP 0,-2(1)↔FLOAT↔FSB 2↔DAC SOY

;FOR ALL THE BODIES OF THE WORLD.
	LAC B,ARG1↔ALT2 B,B
L1:	CCW B,B
	TEST B,BBIT↔GO @VMARK

;FOR ALL THE VERTICES OF EACH BODY.
	LAC V,B
L2:	PVT V,V
	TEST V,VBIT↔GO L1
	TESTZ V,POTENT↔ZAP 7(V)

;COMPUTE DISPLAY COORDINATES OF THE VERTEX.
	LAC X,XPP(V)↔FMPR X,MAG↔FADR X,SOX↔XDC. X,V↔HLLES X
	LAC Y,YPP(V)↔FMPR Y,MAG↔FADR Y,SOY↔YDC. Y,V↔HLLES Y

;DO XY-CLIP MARKING.
	TYPE 0,V↔TRZ(NSEW);NSEW RESET.
	CAMLE Y,YH↔TRO(NORTH)
	CAMGE Y,YL↔TRO(SOUTH)
	CAMLE X,XH↔TRO(EAST)
	CAMGE X,XL↔TRO(WEST)
	TYPE. 0,V
	GO L2
BEND;1/14/73------------------------------------------------------
SUBR(ZCLIP)V1,U,V2------------------------------------------------
BEGIN ZCLIP
	F←0 ↔ U←1
	ACCUMULATORS{V1,V2,X1,Y1,Z1,X2,Y2,Z2}
	SAVAC(11)

;V1 BEHIND CAMERA PLANE, V2 VEFORE CAMERA PLANE.
	CDR V1,ARG3
	CDR  U,ARG2
	CDR V2,ARG1
	LAC F,FOCAL

;UNPROJECT TO CAMERA CENTERED COORDINATES.
	FOR @$ I←1,2{
	MOVN Z$I,SCALEZ↔ FDVR Z$I,ZPP(V$I)
	LAC Y$I,Z$I↔ FMPR Y$I,YPP(V$I)↔ FDVR Y$I,SCALEY
	LAC X$I,Z$I↔ FMPR X$I,XPP(V$I)↔ FDVR X$I,SCALEX}

;PIERCE Z=-FOCAL PLANE BY SIMILAR TRIANGLES & REPROJECT.
	FSBR X1,X2↔ FSBR Y1,Y2↔ FSBR Z1,Z2
	FADR Z2,F↔MOVNS Z2

	FMPR X1,Z2↔FDVR X1,Z1↔FADR X1,X2
	FMPR X1,SCALEX↔FDVR X1,F↔DACN X1,XPP(U)

	FMPR Y1,Z2↔FDVR Y1,Z1↔FADR Y1,Y2
	FMPR Y1,SCALEY↔FDVR Y1,F↔DACN Y1,YPP(U)
	LAC 2,SCALEZ↔FDVR 2,F↔DAC 2,ZPP(U)

;MARK U'S NSEW BITS.
	ACCUMULATORS{XX,YY}
	LAC XX,XPP(U)↔FMPR XX,MAG↔FADR XX,SOX↔XDC. XX,U↔HLLES
	LAC YY,YPP(U)↔FMPR YY,MAG↔FADR YY,SOY↔YDC. YY,U↔HLLES
	TYPE 0,U↔TRZ(NSEW);NSEW RESET.
	CAMLE YY,YH↔TRO(NORTH)
	CAMGE YY,YL↔TRO(SOUTH)
	CAMLE XX,XH↔TRO(EAST)
	CAMGE XX,XL↔TRO(WEST)
	TRZ(PZZ)↔TRO(NZZ)
	TYPE. 0,U

	GETAC(11)
	POP3J
BEND;1/14/73------------------------------------------------------
;XY-CLIPPER, SKIPS WHEN PORTION IS VISIBLE.
;EXPECTS ACCUMULATORS TO BE INITIALIZED.
BEGIN XYCLIP
	ACCUMULATORS{E,V1,V2,X1,Y1,X2,Y2,PTR}
	DECLARE{A,B,C,FLGO,FLGZ,AXH,AXL,BYH,BYL,QNE,QNW,QSW,QSE}

↑XYCLIP: 0
;GET NSEW BITS.
	LDB 0,[POINT 4,(V1),8];
	LDB 1,[POINT 4,(V2),8];
;EASY OUTSIDER EDGE.
	TRNE 0,(1)↔GO @XYCLIP
;GET ENDS' LOCII.
	XDC X1,V1↔YDC Y1,V1
	XDC X2,V2↔YDC Y2,V2

;EASY INSIDER VERTICES.
	JUMPE 0,[LAC X1↔FIXX↔DIP(PTR)↔
	 LAC Y1↔FIXX↔DAP(PTR)↔AOBJN PTR,.+1]
	JUMPE 1,[LAC X2↔FIXX↔DIP(PTR)↔
	 LAC Y2↔FIXX↔DAP(PTR)↔AOBJN PTR,.+1↔GO L]

;COMPUTE EDGE COEFFICIENTS.
	LAC Y1↔FSBR Y2↔DAC A
	LAC X2↔FSBR X1↔DAC B
	LAC X2↔FMPR Y1↔MOVNM C
	LAC X1↔FMPR Y2↔FADRM C

;PARTIAL PRODUCTS.
	LAC A↔FMPR XH↔DAC AXH
	LAC A↔FMPR XL↔DAC AXL
	LAC B↔FMPR YH↔DAC BYH
	LAC B↔FMPR YL↔DAC BYL

;CORNER Q'S.
	SETOM FLGO↔SETZM FLGZ
	LAC AXH↔FADR BYH↔FADR C↔DAC QNE↔ANDM FLGO↔IORM FLGZ
	LAC AXL↔FADR BYH↔FADR C↔DAC QNW↔ANDM FLGO↔IORM FLGZ
	LAC AXL↔FADR BYL↔FADR C↔DAC QSW↔ANDM FLGO↔IORM FLGZ
	LAC AXH↔FADR BYL↔FADR C↔DAC QSE↔ANDM FLGO↔IORM FLGZ

;HARD OUTSIDER CASES.
	SKIPGE FLGO↔GO @XYCLIP
	SKIPL  FLGZ↔GO @XYCLIP
;XY-CLIPPER continued.
;NORTH BORDER CROSSING.
	LAC QNE↔XOR QNW↔SKIPL↔GO L2
	LAC Y1↔CAMGE Y2↔LAC Y2↔CAMG YH↔GO L2
	LAC BYH↔FADR C↔MOVNS↔FDVR A↔FIXX↔DIP(PTR)
	LAC YH↔FIXX↔DAP(PTR)
	AOBJN PTR,.+2↔GO L

;SOUTH BORDER CROSSING.
L2:	LAC QSE↔XOR QSW↔SKIPL↔GO L3
	LAC Y1↔CAMLE Y2↔LAC Y2↔CAML YL↔GO L3
	LAC BYL↔FADR C↔MOVNS↔FDVR A↔FIXX↔DIP(PTR)
	LAC YL↔FIXX↔DAP(PTR)
	AOBJN PTR,.+2↔GO L

;EAST BORDER CROSSING.
L3:	LAC QSE↔XOR QNE↔SKIPL↔GO L4
	LAC X1↔CAMGE X2↔LAC X2↔CAMG XH↔GO L4
	LAC XH↔FIXX↔DIP(PTR)
	LAC AXH↔FADR C↔MOVNS↔FDVR B↔FIXX↔DAP(PTR)
	AOBJN PTR,.+2↔GO L

;WEST BORDER CROSSING.
L4:	LAC QSW↔XOR QNW↔SKIPL↔GO L5
	LAC X1↔CAMLE X2↔LAC X2↔CAML XL↔GO L5
	LAC XL↔FIXX↔DIP(PTR)
	LAC AXL↔FADR C↔MOVNS↔FDVR B↔FIXX↔DAP(PTR)
	AOBJN PTR,.+2↔GO L

;STRANGE EXIT - VMARK & ECOEF ARE INCONSISTENT.
L5:	OUTSTR[ASCIZ/XY-CLIPPER FALL THRU !
/]↔	GO @XYCLIP

;VISIBLE PORTION EXIT.
L:	AOS XYCLIP
	GO @XYCLIP
	LIT
BEND;1/14/73------------------------------------------------------
;END OF XY-CLIPPER.
SUBR(CLIPER)WINDOW -----------------------------------------------
BEGIN CLIPER
	ACCUMULATORS{E,V1,V2,X1,Y1,X2,Y2,PTR,B,LINK}
	JSR VMARK
	SETZM CNT#↔SETZ LINK,;NIL OF THE LIST.

;FOR ALL THE BODIES OF THE WORLD.
	LAC B,ARG1↔ALT2 B,B
L1:	CCW B,B
	TEST B,BBIT↔GO[PED. LINK,B↔POP1J]		;EXIT.

;FOR ALL THE EDGES OF EACH BODY.
	LAC E,B
L2:	PED E,E
	TEST E,EBIT↔GO L1
	TESTZ E,DARKEN↔GO L2
	TEST E,VISIBLE∨POTENT↔GO L2

;DOES EDGE NEED Z-CLIPPING.
	PVT V1,E↔NVT V2,E↔LACI PTR,U
	LDB 1,[POINT 2,(E),10]		;PICKUP PZZ/NZZ.
	SLACI(PZZ∨NZZ)↔ANDCAM(E)	;CLEAR 'EM.
	GO .+1(1)			;PZZ,NZZ
	JFCL				;0,0  - EDGE AIN'T MARKED.
	GO L3				;0,1  - INVIEW HALFSPACE.
	GO L4				;1,0  - OUT'A'SIGHT.
	TEST V2,NZZ			;1,1  - NEEDS Z-CLIPPING.
	EXCH V1,V2			;GET V2 INVIEW.

;CALL SUB-CLIPPER-ROUTINES.
	SETQ(V1,{ZCLIP,V1,PTR,V2})
L3:	SLACI PTR,-2↔LAPI PTR,-3(E)
	JSR XYCLIP
	GO [L4: MARKZ E,VISIBLE↔GO L2]

;CONS EDGE INTO VISIBLE EDGE LIST.
	AOS CNT#
	MARK E,VISIBLE
	ALT2. LINK,E
	LAC   LINK,E
	GO L2

;PSEUDO VERTEX FOR Z-CLIPPER.
	LIT↔VAR
	0↔0↔0↔U: BLOCK 9
BEND;2/5/73-------------------------------------------------------
;MAKE CURVY EDGED OBJECTS.
SUBR(MKCURV)------------------------------------------------------
BEGIN MKCURV
	EXTERN ESPLIT,NORM
	ACCUMULATORS{V,V1,V2,E}
	BDY←15

;PUT NORMAL VECTORS ON EVERYTHING.
 	DAC 12,TMP12#
;	LAC BDY,WORLD
;L1:	CCW BDY,BDY
;	TEST BDY,BBIT↔GO L2
	LAC BDY,ARG1
	SETZ↔CALL(FACOEF,BDY,0)	;WORLD COORDINATES FACE COEF.
	CALL(ENORM,BDY)
	CALL(VNORM,BDY)
;	GO L1

L2:	CCW BDY,BDY
;	TESTZ BDY,BBIT↔GO .+3↔LAC 12,TMP12↔POP0J
	LAC E,ARG1
L3:	PED E,E↔TEST E,EBIT↔GO L2
	MOVSI AA(E)↔HRRI J↔BLT J+2	;EDGE NORMAL AS Y-AXIS.
	PVT V1,E↔NVT V2,E
	TESTZ V1,TMPBIT↔GO L2
	TESTZ V2,TMPBIT↔GO L2

;EDGE FRAME ORIGIN IS THE EDGE'S MIDPOINT.
	LAC XWC(V1)↔FAD XWC(V2)↔FSC -1↔DAC L+0	;ORIGIN AT EDGE MIDPOINT.
	LAC YWC(V1)↔FAD YWC(V2)↔FSC -1↔DAC L+1
	LAC ZWC(V1)↔FAD ZWC(V2)↔FSC -1↔DAC L+2
;EDGE LINE IS THE X-AXIS.
	LAC XWC(V1)↔FSB XWC(V2)↔DAC I+0
	LAC YWC(V1)↔FSB YWC(V2)↔DAC I+1
	LAC ZWC(V1)↔FSB ZWC(V2)↔DAC I+2

;HALF EDGE LENGTH IS UNIT.
	LAC 0,I+0↔FMP
	LAC 1,I+1↔FMP 1,I+1↔FAD 1
	LAC 1,I+2↔FMP 1,I+2↔FAD 1
	CALL(SQRT,0)↔LAC 1		;EDGE'S LENGTH.
	FSC 1,-1↔DAC 1,S		;SCALE UNIT.
	FDVR [0.30]↔FIXX↔DAC CNT#	;NUMBER OF SPACES.
	FSC 233↔MOVSI 1,(1.0)↔DAC 1,X#	;INITIAL X=+1.
	FDVR 1,0↔FSC 1,1↔DACN 1,DX#↔SOS CNT
;CROSS I-VECTOR INTO J-VECTOR TO GET K-VECTOR RIGHT-HANDED.
K1:	LAC 0,I+1↔FMPR 0,J+2
	LAC 1,J+1↔FMPR 1,I+2↔FSBR 0,1↔DAC 0,K+0
	LAC 0,J+0↔FMPR 0,I+2
	LAC 1,I+0↔FMPR 1,J+2↔FSBR 0,1↔DAC 0,K+1
	LAC 0,I+0↔FMPR 0,J+1
	LAC 1,J+0↔FMPR 1,I+1↔FSBR 0,1↔DAC 0,K+2
	MOVEI I↔CALL(NORM,0)

;COMPUTE SLOPE M EDGE'S PVT.
K2:	PVT V,E
	LAC [XWD I,7]↔BLT 14	;PICKUP I&J VECTORS.
	FMP  7,XPP(V)↔FMP 12,XPP(V)	;DOT WITH VERTEX NORMAL.
	FMP 10,YPP(V)↔FMP 13,YPP(V)
	FMP 11,ZPP(V)↔FMP 14,ZPP(V)
	FAD 7,10↔FAD 7,11↔FAD 12,13↔FAD 12,14
	FDVR 7,12↔DACN 7,M#	;SLOPE DY/DX AT PVT.

;COMPUTE SLOPE N EDGE'S NVT.
K3:	NVT V,E
	LAC [XWD I,7]↔BLT 14	;PICKUP I&J VECTORS.
	FMP  7,XPP(V)↔FMP 12,XPP(V)	;DOT WITH VERTEX NORMAL.
	FMP 10,YPP(V)↔FMP 13,YPP(V)
	FMP 11,ZPP(V)↔FMP 14,ZPP(V)
	FAD 7,10↔FAD 7,11↔FAD 12,13↔FAD 12,14
	FDVR 7,12↔DACN 7,N#	;SLOPE DY/DX AT NVT.

;SETUP CUBIC COEFFICIENTS.
K4:	LAC M↔FAD N↔FSC -2
	DAC A#↔DACN C#
	LAC M↔FSB N↔FSC -2
	DAC B#↔DACN D#
;CREATE A VERTEX ON THE CUBIC EDGE.
L4:	LAC X↔FAD DX↔DAC X
	SETQ(V,{ESPLIT,E})
	MARK V,TMPBIT
;LOCUS IN Y = ((A*X+B)*X+C)*X+D).
	LAC A↔FMP X↔FAD B↔FMP X↔FAD C↔FMP X↔FAD D
	FMP S↔DAC 7↔DAC 8↔DAC 9
;EDGE FRAME TO WORLD FRAME.
	FMP 7,J↔FMP 8,J+1↔FMP 9,J+2
	LAC 1,X↔FMP 1,S
	LAC I+0↔FMP 1↔FAD 7,
	LAC I+1↔FMP 1↔FAD 8,
	LAC I+2↔FMP 1↔FAD 9,
	FAD 7,L+0↔FAD 8,L+1↔FAD 9,L+2		;TRANSLATE.
	DAC 7,XWC(V)↔DAC 8,YWC(V)↔DAC 9,ZWC(V)
	SOSLE CNT↔GO L4↔GO L3
	
;EDGE FRAME OF REFERENCE.
	L: 0 ↔ 0 ↔ 0	;ORIGIN.
	I: 0 ↔ 0 ↔ 0
	J: 0 ↔ 0 ↔ 0
	K: 0 ↔ 0 ↔ 0
	S: 0		;SCALE.
;L2:	LAC 12,TMP12↔POP1J
BEND;1/14/73------------------------------------------------------
END
VIEWER.FAI - EOF.